knitr::opts_chunk$set(fig.path="gifs/", dpi = 300)
library(tidyverse)
## ── Attaching packages ──────────────────────────────────────── tidyverse 1.2.1.9000 ──
## ✔ ggplot2 3.2.1.9000 ✔ purrr 0.3.2.9000
## ✔ tibble 2.1.3 ✔ dplyr 0.8.3.9000
## ✔ tidyr 0.8.99.9000 ✔ stringr 1.4.0
## ✔ readr 1.3.1 ✔ forcats 0.4.0
## ── Conflicts ──────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
set.seed(1000)
asdpop_base <- tibble::tibble(
time1 = sample(1:100, 100, replace = F),
time2 = time1) %>%
tidyr::gather(x, y, time1:time2, factor_key = TRUE)
asdpop <- asdpop_base %>%
mutate(services = as.factor(case_when(
x == "time1" & y <= 30 ~ 1,
x == "time1" & y > 30 ~ 0,
x == "time2" & y <= 60 ~ 1,
TRUE ~ 0
)))
dotprint <- ggplot(asdpop, aes(x, y))
dotprint <- dotprint + geom_jitter(aes(fill = services),
position = position_jitter(width=.25,
height = 0,
seed = 2018),
pch = 21,
colour = "black",
size = 2)
dotprint <- dotprint + scale_x_discrete(expand = c(0, 0.6),
name = "",
labels = c("Time 1:\nPoor Service Access", "Time 2:\nBetter Service Access"))
dotprint <- dotprint + scale_y_continuous(expand = c(.02, 0),
name = "ASD Cases per 10,000",
breaks = seq(0, 100, by = 20))
dotprint <- dotprint + theme_bw(base_family = "Lato")
dotprint <- dotprint + theme(axis.ticks = element_blank())
dotprint <- dotprint + theme(panel.border = element_blank())
dotprint <- dotprint + theme(panel.grid = element_blank())
dotprint <- dotprint + theme(axis.title.y = element_text(size = 10))
dotprint <- dotprint + theme(axis.text = element_text(size = 10))
dotprint <- dotprint + coord_cartesian(ylim = c(0, 102), xlim = c(1, 3.2))
dotprint <- dotprint + scale_fill_manual(name = "ASD cases who are:",
values = c("black", "white"),
labels = c("Not accessing services",
"Accessing services"))
dotprint <- dotprint + guides(colour = guide_legend(keywidth = 1.1,
keyheight = 1.1,
override.aes = list(alpha = 1, size = 3)))
dotprint <- dotprint + theme(legend.position=c(.75, .25))
dotprint <- dotprint + theme(legend.text = element_text(size = 10))
dotprint <- dotprint + theme(legend.title = element_text(size = 10))
dotprint <- dotprint + theme(legend.background = element_rect(fill = "gray90",
size=.3,
linetype="dotted"))
# top line
dotprint <- dotprint + geom_segment(aes(x = .6, xend = 2.4, y = 100, yend = 100),
lty = 3, lwd = .5, colour = "black")
dotprint <- dotprint + annotate("text",
x = 2.5, y = 97, size = 4, hjust = 0,
family = "Lato",
label = "Estimates of prevalence based\non population sampling will remain\nstable over time if true prevalence\nis stable.")
# bottom line
dotprint <- dotprint + geom_segment(aes(x = .6, xend = 1.3, y = 30, yend = 30),
lty = 3, lwd = .5, colour = "black")
dotprint <- dotprint + geom_segment(aes(x = 1.3, xend = 1.7, y = 30, yend = 60),
lty = 3, lwd = .5, colour = "black")
dotprint <- dotprint + geom_segment(aes(x = 1.7, xend = 2.4, y = 60, yend = 60),
lty = 3, lwd = .5, colour = "black")
dotprint <- dotprint + annotate("text",
x = 2.5, y = 60, size = 4, hjust = 0,
family = "Lato",
label = "Estimates of prevalence based\non individuals accessing services\ncan create an illusion of an\nincrease in prevalence over time,\nyet still underestimate prevalence\nat both time points.")
dotprint
library(gganimate)
dotprint +
transition_layers(layer_length = 1, transition_length = 2,
from_blank = FALSE) +
enter_fade()
pos <- position_jitter(width = .25,
height = 0,
seed = 2018)
dotleg <- ggplot(asdpop, aes(x, y))
dotleg <- dotleg + geom_jitter(aes(colour = services),
position = pos,
alpha = .9, size = 2)
dotleg <- dotleg + scale_x_discrete(expand = c(0, 0.6),
name = "",
labels = c("Time 1:\nPoor Service Access", "Time 2:\nBetter Service Access"))
dotleg <- dotleg + scale_y_continuous(expand = c(.02, 0),
name = "ASD Cases per 10,000",
breaks = seq(0, 100, by = 20))
dotleg <- dotleg + theme_bw(base_family = "Lato")
dotleg <- dotleg + theme(axis.ticks = element_blank())
dotleg <- dotleg + theme(panel.border = element_blank())
dotleg <- dotleg + theme(panel.grid = element_blank())
dotleg <- dotleg + theme(axis.title.y = element_text(size = 10))
dotleg <- dotleg + theme(axis.text = element_text(size = 10))
dotleg <- dotleg + coord_cartesian(ylim = c(0, 102), xlim = c(1, 3.2))
dotleg <- dotleg + scale_color_viridis_d(option = "D", begin = .45, end = 1,
name = "ASD cases who are:",
labels = c("Not accessing services",
"Accessing services"))
dotleg <- dotleg + guides(colour = guide_legend(keywidth = 1.1,
keyheight = 1.1,
override.aes = list(alpha = 1, size = 3)))
dotleg <- dotleg + theme(legend.position=c(.75, .25))
dotleg <- dotleg + theme(legend.text = element_text(size = 10))
dotleg <- dotleg + theme(legend.title = element_text(size = 10))
dotleg <- dotleg + theme(legend.background = element_rect(fill = "gray90",
size=.3,
linetype="dotted"))
dottop <- dotleg + geom_segment(aes(x = .6, xend = 2.4, y = 100, yend = 100),
lty = 3, lwd = .5, colour = "black")
dottop <- dottop + annotate("text",
x = 2.5, y = 97, size = 4, hjust = 0,
family = "Lato",
label = "Estimates of prevalence based\non population sampling will remain\nstable over time if true prevalence\nis stable.")
dotboth <- dottop + geom_segment(aes(x = .6, xend = 1.3, y = 30, yend = 30),
lty = 3, lwd = .5, colour = "black")
dotboth <- dotboth + geom_segment(aes(x = 1.3, xend = 1.7, y = 30, yend = 60),
lty = 3, lwd = .5, colour = "black")
dotboth <- dotboth + geom_segment(aes(x = 1.7, xend = 2.4, y = 60, yend = 60),
lty = 3, lwd = .5, colour = "black")
dotboth <- dotboth + annotate("text",
x = 2.5, y = 60, size = 4, hjust = 0,
family = "Lato",
label = "Estimates of prevalence based\non individuals accessing services\ncan create an illusion of an\nincrease in prevalence over time,\nyet still underestimate prevalence\nat both time points.")
dotboth
dotboth +
transition_layers(layer_length = 2, transition_length = 2) +
#enter_grow() +
enter_fade() +
enter_recolour(colour = 'black')
## Warning in lapply(data, as.numeric): NAs introduced by coercion
dotanim <- ggplot()
dotanim <- dotanim + geom_jitter(data = asdpop,
aes(x, y),
colour = viridisLite::magma(1, begin = .1),
position = position_jitter(width = .25,
height = 0,
seed = 2018),
alpha = .9, size = 2)
dotanim <- dotanim + geom_jitter(data = asdpop,
aes(x, y, colour = services),
position = position_jitter(width = .25,
height = 0,
seed = 2018),
alpha = .75, size = 2)
dotanim <- dotanim + scale_x_discrete(expand = c(0, 0.6),
name = "",
labels = c("Time 1:\nPoor Service Access", "Time 2:\nBetter Service Access"))
dotanim <- dotanim + scale_y_continuous(expand = c(.02, 0),
name = "ASD Cases per 10,000",
breaks = seq(0, 100, by = 20))
dotanim <- dotanim + theme_bw(base_family = "Lato")
dotanim <- dotanim + theme(axis.ticks = element_blank())
dotanim <- dotanim + theme(panel.border = element_blank())
dotanim <- dotanim + theme(panel.grid = element_blank())
dotanim <- dotanim + theme(axis.title.y = element_text(size = 10))
dotanim <- dotanim + theme(axis.text = element_text(size = 10))
dotanim <- dotanim + guides(colour = guide_legend(keywidth = 1.1,
keyheight = 1.1,
override.aes = list(alpha = 1, size = 3)))
dotanim <- dotanim + theme(legend.position=c(.75, .25))
dotanim <- dotanim + theme(legend.text = element_text(size = 10))
dotanim <- dotanim + theme(legend.title = element_text(size = 10))
dotanim <- dotanim + theme(legend.background = element_rect(fill = "gray90",
size=.3,
linetype="dotted"))
dotanim <- dotanim + coord_cartesian(ylim = c(0, 102), xlim = c(1, 3.2))
dotanim <- dotanim + scale_color_viridis_d(option = "A", begin = .1, end = .7,
name = "ASD cases who are:",
labels = c("Not accessing services",
"Accessing services"))
# top lines
dotanim <- dotanim + geom_segment(aes(x = .6, xend = 2.4, y = 100, yend = 100),
lty = 3, lwd = .5, colour = "black")
dotanim <- dotanim + annotate("text",
x = 2.5, y = 97, size = 4, hjust = 0,
family = "Lato",
label = "Estimates of prevalence based\non population sampling will remain\nstable over time if true prevalence\nis stable.")
# bottom line
dotanim <- dotanim + geom_segment(aes(x = .6, xend = 1.3, y = 30, yend = 30),
lty = 3, lwd = .5, colour = "black")
dotanim <- dotanim + geom_segment(aes(x = 1.3, xend = 1.7, y = 30, yend = 60),
lty = 3, lwd = .5, colour = "black")
dotanim <- dotanim + geom_segment(aes(x = 1.7, xend = 2.4, y = 60, yend = 60),
lty = 3, lwd = .5, colour = "black")
dotanim <- dotanim + annotate("text",
x = 2.5, y = 60, size = 4, hjust = 0,
family = "Lato",
label = "Estimates of prevalence based\non individuals accessing services\ncan create an illusion of an\nincrease in prevalence over time,\nyet still underestimate prevalence\nat both time points.")
# animate this thing
dotanim <- dotanim +
transition_layers(layer_length = 2, transition_length = 2,
keep_layers = c(0, Inf, Inf, Inf, Inf, Inf, Inf)) +
enter_fade()
animate(dotanim, start_pause = 5, end_pause = 20)